<%
Public function killint(ByVal i,ByVal killstr,ByVal killsub,ByVal trimleft)
	If Not IsNumeric(killstr)  Then killstr=0 End If
	If Not IsNumeric(killsub)  Then killsub=0 End If
	If Not IsNumeric(trimleft)  Then trimleft=1 End if
	if isnull(i) then i =0
		i = Left(CStr(i),trimleft )
	If Not IsNumeric(i) Then
		i=killstr
	ElseIf i<=0 Then
		i=killsub
	End if
		on error resume next 
		killint=Int(i+0.5)'不要修改成cint，否则容量不够
End Function

Function GetIp()
	Dim userip
	userip = Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
	If userip=Empty Then userip=Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
	GetIp = userip
End Function 

'
'
'控制生成静态页面
Function getHTTPPage(url)
    dim objXML
    set objXML=server.createobject("MSXML2.XMLHTTP")'定义
    objXML.open "GET",url,false'打开
    objXML.send()'发送
    If objXML.readystate<>4 then '判断文档是否已经解析完，以做客户端接受返回消息
        exit function
    End If
		getHTTPPage=BytesToBstr(objXML.responseBody)'返回信息，同时用函数定义编码
		getHTTPPage=bytes2BSTR(objXML.responseBody)'或者返回信息时用函数转换汉字
		'getHTTPPage=objXML.responseBody'或者返回信息时用函数转换汉字

    set objXML=nothing'关闭
    if err.number<>0 then err.Clear 
End Function

Function BytesToBstr(body)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.Mode =3
    objstream.Open
    objstream.Write body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = "utf-8"  
    '转换原来默认的UTF-8编码转换成GB2312编码，否则直接用XMLHTTP调用有中文字符的网页得到的将是乱码
    BytesToBstr = objstream.ReadText 
objstream.Close
set objstream = nothing
End Function

Function bytes2BSTR(vIn)
Dim strReturn,j,ThisCharCode,NextCharCode
strReturn = "" 
For j = 1 To LenB(vIn) 
    ThisCharCode = AscB(MidB(vIn,j,1)) 
    If ThisCharCode < &H80 Then 
        strReturn = strReturn & Chr(ThisCharCode) 
    Else 
        NextCharCode = AscB(MidB(vIn,j+1,1)) 
        strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 
        j = j + 1 
    End If 
Next 
bytes2BSTR = strReturn 
End Function
'文件读取
Function GetFileContent(ByVal filename)
	Dim objStream,fget
	On Error Resume Next
	Set objStream = Server.CreateObject("ADODB.Stream")
	With objStream
		.Type = 2
		.Mode = 3
		.Open
		.LoadFromFile filename
		If Err.Number<>0 Then
			GetFileContent =  filename & " 不存在"
			Err.Clear
			Exit Function 
		End If
		.Charset = Response.Charset 
		.Position = 2
		GetFileContent = .ReadText
		.Close
	End With
	Set objStream = Nothing
End Function

'文件存在
Function FileExists(filename)
	on error resume next
	Dim fso,fpath,fget,objtext
	Set fso =Server.CreateObject("Scripting.FileSystemObject")
	filename=Replace(filename,"/","\")
	If(InStr(filename,":\")=0) Then 
		fpath = server.mappath(filename)
	Else
		fpath = filename
	End If 
	
'	response.write(fpath)&"<hr/>"
	if fso.fileexists(fpath) then 
		FileExists =true 
	else
		FileExists =false 
	End if
	if err then 
		'response.write(err.Description)
		err.clear
		FileExists =false 
		exit Function
	End if
End Function 
'文件写入
Function writetoFSO(xmlfloder,xmlfile,content)
'	on error resume next
	writetoFSO=false
	Dim fso 
	mode=killint(mode,0,0,2)
	xmlfloder = Replace(xmlfloder,"/","\")
	If Not CreateFolder(xmlfloder) Then Exit Function 

	Set fso =Server.CreateObject("Scripting.FileSystemObject")
		if not fso.folderexists(xmlfloder) Then
		fso.createfolder(xmlfloder)
		End If
	xmlfile=replace(xmlfloder&"\","\\","\")&xmlfile
'	response.write(warn_red(xmlfile))
	Dim fsoxml
	If fso.fileexists(xmlfile) And mode=1 Then '存在不写
		Exit Function 
	elseIf fso.fileexists(xmlfile) And mode=2 Then '重写
		Set fsoxml=fso.opentextfile(xmlfile,2)
		fsoxml.writeline(content)
		fsoxml.close
		writetoFSO=true
	ElseIf fso.fileexists(xmlfile) And mode=8 Then '追加
		Set fsoxml=fso.opentextfile(xmlfile,8)
		fsoxml.writeline(content)
		fsoxml.close
		writetoFSO=true
	ElseIf fso.fileexists(xmlfile) Then 
		Set fsoxml=fso.opentextfile(xmlfile,2)'重写
		fsoxml.writeline(content)
		fsoxml.close
		writetoFSO=true
	Else
		Set fsoxml=fso.createtextfile(xmlfile)'创建
		fsoxml.writeline(content)
		fsoxml.close
		writetoFSO=true
	End If 
End Function
Function ForSiteMapDateTime(Mystr)
	ForSiteMapDateTime = Year(Mystr) & "-" & AddZero(Month(Mystr)) & "-" & AddZero(Day(Mystr)) & "T"& AddZero(Hour(Mystr)) &":"& AddZero(Minute(Mystr)) & ":" & AddZero(Hour(Mystr)) & "+00:00"
End Function 
Function AddZero(str)
	If (Len(str)=1) Then str="0" & str
	AddZero = str
End Function
Function WriteTo(path,str)
	Dim xmlfloder
	path=Replace(path,"/","\")
	xmlfloder = left(path,InstrRev(path,"\"))
	If Not CreateFolder(xmlfloder) Then Exit Function 
	Dim objStream
	Set objStream = Server.CreateObject("ADODB.Stream") 
	With objStream 
	.Open 
	.Charset = "utf-8" 
	.Position = objStream.Size 
	.WriteText=str 
	.SaveToFile path,2 
	.Close 
	End With 
	Set objStream = Nothing 
	WriteTo = True 
End Function 
'判断是否是可以Execute的ASP文件
Function IsValidAspCode(aspFile)
	on error resume Next
	If(FileExists( aspFile )) Then 
		execute(GetFileContent(aspFile))
	Else
		IsValidAspCode = False
		Exit Function 
	End If 
	If Err Then
		IsValidAspCode = False
		Exit Function 
	End If 
	IsValidAspCode = True 
End Function 
'删除文件
Function DeleteFile(x)
	On Error Resume Next 
		DeleteFile=False 
	If Not FileExists(x) Then 
		Exit Function 
	Else
		Dim fsoDel
		Set fsoDel =Server.CreateObject("Scripting.FileSystemObject")
		fsoDel.deletefile x
		DeleteFile=True  
		Set fsoDel=Nothing 
	End if 
End Function
'删除文件夹
Function DeleteFolder(sFullName)
	'On Error Resume Next 
	sFullName = RemoveTrim(replace(sFullName, "/", "\"),"\")
	Dim g_oFSO,tmpfolder,tmpfiles,tmpsubfolder,tmpfile
	Set g_oFSO=Server.CreateObject("Scripting.FileSystemObject")
	
	If (g_oFSO.FolderExists(sFullName)) then
		set tmpfolder=g_oFSO.GetFolder(sFullName)
		set tmpfiles=tmpfolder.files
		for each tmpfile in tmpfiles
			'g_oFSO.DeleteFile (tmpfile)
		next
		set tmpsubfolder=tmpfolder.SubFolders
		for each tmpfolder in tmpsubfolder
			DeleteFolder(Left(sFullName,InstrRev(sFullName,"\")) & tmpfolder.name )
		next
		g_oFSO.DeleteFolder ( sFullName )
	End If 
	Set g_oFSO=Nothing 
End Function

'抑制错误
Function CoutError(mode,str)
	Dim mess 
	Select Case mode 
		Case 1:mess = "<h2 style='color:#E80702;font-weight:bold;text-align:center;font-size:15px'>"&str&"</h2>"
		Case 6:mess = "<meta http-equiv=refresh content='3;url="&str&"' />" 
		Case 8:mess = "<script lanuage='javascript'>document.href="&str&"</scipt>"
		Case 9:mess = "<script  language='javascript'>alert('"&str&"');history.back(-1);</script>"
		
	End Select 
	CoutError = mess  
End Function 

'创建文件夹
Function CreateFolder(strPath) 
       ' On Error Resume Next

		Dim astrPath, ulngPath, Loopi, strTmpPath
        Dim objFSO

        If InStr(strPath, "\") <=0 Or InStr(strPath, ":") <= 0 Then
                CreateFolder = False
                Exit Function
        End If
		strPath =Replace( Replace(strPath,"/","\"),"\\","\")
        Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
        If objFSO.FolderExists(strPath) Then
                CreateFolder = True
                Exit Function
        End If
        astrPath = Split(strPath, "\")
        ulngPath = UBound(astrPath)
        strTmpPath = ""
        For Loopi = 0 To ulngPath
                strTmpPath = strTmpPath & astrPath(Loopi) & "\"
                If Not objFSO.FolderExists(strTmpPath) Then
                        objFSO.CreateFolder(strTmpPath)
                End If
        Next
        Set objFSO = Nothing
        If Err = 0 Then
                CreateFolder = True
        Else
                CreateFolder = False
        End If
End Function 








function PageInfo(pagecount,pagesize,paget,resultcount)
    Dim actions,query, a, x, temp,rmess
    actions = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
    query = Split(Request.ServerVariables("QUERY_STRING"), "&")
    For Each x In query
        a = Split(x, "=")
        If StrComp(a(0), "page", vbTextCompare) <> 0 Then
            temp = temp & a(0) & "=" & a(1) & "&"
        End If
    Next    
    if paget<=1 then
        rmess = ("首页&nbsp;&nbsp;上一页&nbsp;")
    else        
        rmess =("<a href=" & actions & "?" & temp & "page=1>首页</a>&nbsp;&nbsp;")
        rmess = rmess& ("<a href=" & actions & "?" & temp & "page=" & (paget-1) & ">上一页</a>&nbsp;")
    end if
    if paget >= pagecount then
        rmess = rmess & (" 下一页&nbsp;尾页")        
    else
        rmess = rmess& ("<a href=" & actions & "?" & temp & "page=" & (paget+1) & ">下一页</a>&nbsp;")
        rmess = rmess& ("<a href=" & actions & "?" & temp & "page=" & pagecount & ">尾页</a>&nbsp;")            
    end if
    rmess = rmess& (" 页次:<font color=red>" & paget & "</font>/" & pageCount)    
    rmess = rmess& (" 共" & resultcount & "条 <font color=red>"& pagesize & "</font>条/页 ")
	PageInfo = rmess
End Function






'----------------------------------------------------
rem write by ?
'----------------------------------------------------
Function IsValidUserName(byVal UserName)
	Dim i,c
	IsValidUserName = True
	For i = 1 To Len(UserName)
		c = Lcase(Mid(UserName, i, 1))
		IF InStr("$!<>?#^%@~`&*(){};:_,/+='"" 		", c) > 0 Then
				IsValidUserName = False
				Exit Function
		End IF
	Next
End Function

Function IsInteger(Para) '检测是否有效的数字
	'dim vt:vt = VarType(Para) (vt=2) or (vt=3) or (vt=17)
	
    Dim TempReg
    Set TempReg = New RegExp
        TempReg.IgnoreCase = True
        TempReg.Global = True
        TempReg.Pattern =  "^([0-9]{1,10})$" '  "[^\u4e00-\u9fa5]"
        IsInteger = TempReg.Test(Para)
    Set TempReg = Nothing

End Function



Function HTMLEncode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = Replace(Str, "&", "&amp;")
		Str = Replace(Str, ">", "&gt;")
		Str = Replace(Str, "<", "&lt;")
		Str = Replace(Str, CHR(32), "&nbsp;")
	    Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
		Str = Replace(Str, CHR(34),"&quot;")
		Str = Replace(Str, CHR(39),"&#39;")
		Str = Replace(Str, CHR(13), "")
		Str = Replace(Str, CHR(10), "<br>")
		HTMLEncode = Str
	End If
End Function

Function EditDeHTML(byVal Content)
	EditDeHTML=Content
	IF Not IsNull(EditDeHTML) Then
		EditDeHTML=Replace(EditDeHTML,"&","&amp;")
		EditDeHTML=Replace(EditDeHTML,"<","&lt;")
		EditDeHTML=Replace(EditDeHTML,">","&gt;")
		EditDeHTML=Replace(EditDeHTML,CHR(34),"&quot;")
		EditDeHTML=Replace(EditDeHTML,CHR(39),"&#39;")
	End IF
End Function

Function DateToStr(DateTime,ShowType)  '日期转换函数
	Dim DateMonth,DateDay,DateHour,DateMinute
	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	Select Case ShowType
	Case "Y-m-d"  
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
	Case "Y-m-d H:I A"
		Dim DateAMPM
		If DateHour>12 Then 
			DateHour=DateHour-12
			DateAMPM="PM"
		Else
			DateHour=DateHour
			DateAMPM="AM"
		End If
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
	Case "Y-m-d H:I:S"
		Dim DateSecond
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	Case "YmdHIS"
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond	
	Case "ym"
		DateToStr=Right(Year(DateTime),2)&DateMonth
	Case "d"
		DateToStr=DateDay
	Case Else
		If Len(DateHour)<2 Then DateHour="0"&DateHour
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
	End Select
End Function

Function IsValidEmail(Email) '检测是否有效的E-mail地址
	Dim names, name, i, c
	IsValidEmail = True
	Names = Split(email, "@")
	If UBound(names) <> 1 Then
   		IsValidEmail = False
   		Exit Function
	End If
	For Each name IN names
		If Len(name) <= 0 Then
     		IsValidEmail = False
     		Exit Function
   		End If
   		For i = 1 to Len(name)
     		c = Lcase(Mid(name, i, 1))
     		If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
       			IsValidEmail = false
       			Exit Function
     		End If
   		Next
   		If Left(name, 1) = "." or Right(name, 1) = "." Then
      		IsValidEmail = false
      		Exit Function
   		End If
	Next
	If InStr(names(1), ".") <= 0 Then
   		IsValidEmail = False
   		Exit Function
	End If
	i = Len(names(1)) - InStrRev(names(1), ".")
	If i <> 2 And i <> 3 Then
   		IsValidEmail = False
   		Exit Function
	End If
	If InStr(email, "..") > 0 Then
   		IsValidEmail = False
	End If
End Function

Function SplitLines(byVal Content,byVal ContentNums) '切割内容
	Dim ts,i,l
	If IsNull(Content) Then Exit Function
	i=1
	ts = 0
	For i=1 to Len(Content)
      	l=Mid(Content,i,4)
      	If l="<br>" Then
         	ts=ts+1
      	End If
      	If ts>ContentNums Then Exit For 
	Next
	If ts>ContentNums Then
    	Content=Left(Content,i-1)
	End If
	SplitLines=Content
End Function

Function Generator(Length)
	Dim i, tempS
	tempS = "abcdefghijklmnopqrstuvwxyz1234567890" 
	Generator = ""
	If isNumeric(Length) = False Then 
		Exit Function 
	End If 
	For i = 1 to Length 
		Randomize 
		Generator = Generator & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
	Next 
End Function 

Function CutStr(byVal Str,byVal StrLen)
	Dim l,t,c,i
	if isnull(Str) then
	CutStr =""
	exit Function 
	End if
	l=Len(str)
	t=0
	if StrLen=0  then 
		CutStr = str
	else 
		For i=1 To l
			c=AscW(Mid(str,i,1))
			If c<0 Or c>255 Then t=t+2 Else t=t+1
			IF t>=StrLen Then
				CutStr=left(Str,i)&"..."
				Exit For
			Else
				CutStr=Str
			End If
		Next
	End if 
End Function
'移出html标签
Function ClearHtml(Content)
	if len(Content)<1 then 
	ClearHtml = ""
	exit Function
	End if

    Dim TempReg
    Set TempReg = New RegExp
        TempReg.IgnoreCase = True
        TempReg.Global = True
        TempReg.Pattern =  "<[^>]*>" '  "[^\u4e00-\u9fa5]"
        ClearHtml = TempReg.Replace(Content,"")
    Set TempReg = Nothing
End Function

'检查外部提交数据
Public Sub CheckOutPost() 
  Dim Server_V1,Server_V2 
  Server_V1=Cstr(Request.ServerVariables("HTTP_REFERER")) 
  Server_V2=Cstr(Request.ServerVariables("SERVER_NAME")) 
  If Mid(Server_V1,8,Len(Server_V2))<>Server_V2 Then 
		response.redirect(Server_V2)
		response.End()
  End If
End Sub
'
public Function HtmlXmlData(str)
	if isnull(str) then HtmlXmlData=""
	str=replace(str,"&lt;","<")
	str=replace(str,"&gt;",">")
	str=replace(str,"&nbsp;"," ")
HtmlXmlData=str
End Function 
'判断数组里面的值是否存在
Public Function In_Array(strs,arrs)
	If(Not IsArray(arrs))   Then
		In_Array = False 
		Exit Function 
	End If 
	On Error Resume Next 
	Dim ai
	For ai=0 To LBound(arrs)
		If(arrs(ai)=strs) Then 
			In_Array = True 
			Exit Function 
		End If 
	Next 
	If Err Then
		In_Array = False 
		err.Clear
		Exit Function 
	End if
	In_Array = False 
End Function 

Function GetXml(Arrs)
	Dim xmlStr,ai,ay
	xmlStr ="<NewTables>"
	If(IsArray(Arrs)) Then 
		For ai=0 To uBound(Arrs,2)
		xmlStr = xmlStr & "<Table>"
			For ay=0 To UBound(Arrs,1)
			xmlStr = xmlStr & "<Col"&  ay &">"
			xmlStr = xmlStr & "<![CDATA["& Arrs(ay,ai) &"]]>"
			xmlStr = xmlStr & "</Col"& ay &">"
			Next 
		xmlStr = xmlStr & "</Table>"			
		Next 
	End If 
	xmlStr = xmlStr & "</NewTables>"
	GetXml= xmlStr
End Function 
'计算页数
Function GetPageCount(allpage,pagelist)
	allpage=killint(allpage,0,0,8)
	pagelist=killint(pagelist,0,0,3)
	If(allpage=0 Or pagelist=0) Then 
		GetPageCount = 1
		Exit Function 
	End If 
	Dim pagei
	pagei= int(allpage/pagelist)
	If(allpage Mod pagelist) >0 Then pagei=pagei+1
	GetPageCount = pagei 
End Function 
'输出列表的Html分页
Function GetDirIndexPageInfo( iNowPage,iPageList,iAllPage,sUrlList,iLoopTemp)
	Dim strMess , allPageCount,evalPage
	evalPage = killint(iLoopTemp/2,1,1,10)
	strMess = ""
	iNowPage = killint(iNowPage,1,1,8)
	allPageCount = GetPageCount(iAllPage,iPageList)
	If(iNowPage > allPageCount)  Then iNowPage = allPageCount 
	Dim startI,stopI,Ai
	startI = iNowPage - evalPage 
	stopI =  iNowPage + evalPage 
	If(startI<1) Then startI = 1
	If(allPageCount < iLoopTemp) Then 
		startI = 1
		stopI = allPageCount
	End If 
	If(allPageCount >= iLoopTemp) Then 
		If(stopI- startI<iLoopTemp) Then 
			stopI = startI + iLoopTemp
		End If 
	End If 
	If(stopI>allPageCount) Then stopI= allPageCount
	For Ai = startI To stopI
		If( Ai <> iNowPage  ) Then 
			Dim newIdPage
			newIdPage = allPageCount - Ai + 1 
			strMess = strMess & " <span><a href="& Replace(sUrlList,"{0}",newIdPage) &">"& Ai &"</a></span>"
		Else 
			strMess = strMess & " <span class='selected'>"& iNowPage &"</span>"
		End If 
	Next 
	strMess = strMess & ""
	GetDirIndexPageInfo = strMess
End Function 
'去除前后字符串

Function RemoveTrim(strOld,strDel)
	If(Len(strOld)<1) Then Exit Function 
	If(Len(strDel) > Len(strOld)) Then 
		RemoveTrim = strOld
		Exit Function 
	End If 
	Do while(Left(strOld,Len(strDel))) = strDel  
		strOld = Mid(strOld,1+Len(strDel))
	Loop 
	Do while(right(strOld,Len(strDel))) = strDel   
		strOld = Mid(strOld,1,Len(strOld)-Len(strDel))
	Loop 
	RemoveTrim = strOld
End Function 
Function BeginWith(ByVal str1,ByVal str2)  
    Dim length  
    length = len(str2)  
    if Left(str1,length) = str2 then  
        BeginWith = true  
    else  
        BeginWith = false  
    end if  
end Function

'移出key的application
Function RemoveApplicationKey(key)
	Application.contents.remove(key)
End Function 
'==========================================================
'根据输入的键对应的值取出数组的值
'
'
'Key	--------------------0-----------1-----------2-----------3
'Data	--------------------0-----------1-----------2-----------3
'Array	--------------------0-----------1-----------2-----------3


'使用方法为：
'call MakeAppData(1)【强制更新】
'call GetAppData (1)【获取数据】

Function GetAppData(key)
	key = killint(key,(MaxAppUboundKey+1),0,3)
	if key = (MaxAppUboundKey+1) then exit Function 
	call UpDateAppKey(key)'检测 key 键列是否需要更新
	Dim temparr,temparrdetail
	temparr = Application(PreStr & AppArrData)
	if not isarray(temparr) then 
		call MakeAppArrData()'Data列不是数组，全部初始化数据数组Data 一次.
		temparr = Application(PreStr & AppArrData)
	End if 
	if ubound(temparr) > MaxAppUboundKey then 
		response.write("下标越界")
		response.End()
	else
		GetAppData = temparr(key)
	End if 
End Function 
'创建数组		值	的启动函数
Function MakeAppArrData()
	Dim ai
	for ai = 0 to MaxAppUboundKey
		call MakeAppData(ai)
	next
	'response.write("<hr/>call MakeAppArrData()<hr/>")
End Function 
'创建数组		键	的启动函数
Function MakeAppArrKey()
	Dim ai,arrs
	redim arrs(MaxAppUboundKey)
	for ai = 0 to MaxAppUboundKey
		arrs(ai) =1
	next
	Application.Lock
	application(PreStr & AppUpdateKey) = arrs
	Application.UnLock
End Function 



'更新 key 键，同时更新数据库
Function UpDateAppKey(key)
	key = killint(key,(MaxAppUboundKey+1),0,3)
	if key = (MaxAppUboundKey+1) then exit Function 

	Dim temparr,temparrdetail
	temparr = Application(PreStr & AppUpdateKey)
	if not isarray(temparr) then 
		call MakeAppArrKey()
		temparr = Application(PreStr & AppUpdateKey)
	End if 
		if ubound(temparr) > MaxAppUboundKey then 
			response.write("下标越界")
			response.End()
		else
			temparrdetail = temparr(key)
			if killint(temparrdetail,0,0,2) = 1 then 
				call ChangeAppKey(key,0)'更新缓存键
				call MakeAppData(key)'更新数据项
			End if
		End if 
End Function

'更新缓存键
Function ChangeAppKey(yappkey,yappvalue)
'	response.write("ChangeAppKey")

	Dim appkey,appda
	appkey=killint(yappkey,0,0,5)
	appda=application(PreStr & AppUpdateKey)
	if not isarray(appda) then 
		call MakeAppArrKey()
		appda=application(PreStr & AppUpdateKey)
	End if 
	if ubound(appda) > MaxAppUboundKey then 
			response.write("下标越界")
			response.End()
	else
		appda(appkey)= killint(yappvalue,0,0,5)
		Application.Lock
		application(PreStr & AppUpdateKey) = appda
		Application.UnLock
	End if 
End Function
'创建数组的Data 值
Function MakeAppData(key)
'		response.write CoutError(1,"<hr/>MakeAppData the Data of ["&key&"] application is successful<br/>")
	Dim oldarr
	select case killint(key,0,0,3) 
		case 0:
			oldarr= Array("Debug")
			Response.Write("hre")
			response.End 
			call ChangeAppData(0,oldarr)'整体数据
		case 1:
			'获取栏目数据
			oldarr= GetCatalogueCacheData()
			call ChangeAppData(1,oldarr)'栏目数据

	End select 
End Function 
'三目运算符
Public Function IIF(boolC,yesC,noC)
	If(boolC) Then 
		IIF=yesC
	Else
		IIF=noC
	End If 
End Function 
'更新关键的控制读取数据库的缓存数据
Function ChangeAppData(yappkey,yappvalue)

	Dim appkey,appda
	appkey = killint(yappkey,0,0,5)
	appda=application(PreStr & AppArrData)
	if not isarray(appda) then
		call MakeAppArrIniData()
		appda=application(PreStr & AppArrData)
	End if 
	if ubound(appda) > MaxAppUboundKey then 
			response.write("下标越界")
			response.End()
	else
		appda(appkey)= yappvalue
		Application.Lock
		application(PreStr & AppArrData) = appda
		Application.UnLock

'	response.write CoutError(1,"<br/>update the data of ["&yappkey&"] application is successful<br/>")


	End if 
End Function
'强制初试化
Function MakeAppArrIniData()
'	response.write CoutError(1,"<br/>call MakeAppArrIniData()<br/>")

	Dim arrs
	redim arrs(MaxAppUboundKey)
		Application.Lock
		application(PreStr & AppArrData) = arrs
		Application.UnLock
End Function 
'
'各种缓存取得的值
'


Function ReadBinaryFile(FileName)
  Const adTypeBinary = 1
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Open
  BinaryStream.LoadFromFile FileName
  ReadBinaryFile = BinaryStream.Read
End Function
'Response.AddHeader "Content-Disposition", "attachment;filename=2.gif"'文件名
'Response.ContentType = "image/GIF" '设置（1）
'response.Binarywrite ReadBinaryFile(server.mappath("edit/edit/1.gif"))'



%>